home *** CD-ROM | disk | FTP | other *** search
/ The 640 MEG Shareware Studio 2 / The 640 Meg Shareware Studio CD-ROM Volume II (Data Express)(1993).ISO / pascal / mltsktp.zip / MTEST.PAS < prev    next >
Pascal/Delphi Source File  |  1988-09-20  |  3KB  |  108 lines
  1. {$R-,S-,I-,D-,T-,F-,V+,B-,N-,L+ }
  2. Program MTest;
  3.  
  4. { Message-Passing Test
  5.   Christian Philipps
  6.   6/88
  7. }
  8.  
  9. USES Dos, Crt, Tp4Multi;
  10.  
  11. VAR MessageBuffer : String;
  12.     SubNo         : TaskNoType;
  13.     BeepNo        : TaskNoType;
  14.  
  15. {-----------------------------------------------------------------------------}
  16.  
  17. PROCEDURE TaskMsgOut(txt : string);
  18.  
  19. { Safe output of a string to the screen }
  20.  
  21. BEGIN {TaskMsgOut}
  22.   BindCPU;
  23.   Writeln(txt);
  24.   ReleaseCPU;
  25. END;  {TaskMsgOut}
  26.  
  27. {-----------------------------------------------------------------------------}
  28.  
  29. PROCEDURE Beep;
  30.  
  31. { First Sub-Task }
  32.  
  33. BEGIN {Beep}
  34.   REPEAT
  35.     Sound(200);
  36.     Delay(5);
  37.     NoSound;
  38.   UNTIL Keypressed;
  39.  
  40.   TaskMsgOut('Beep: Sending to SubTask...');
  41.   IF Send(SubNo,@MessageBuffer,Length(MessageBuffer)+1,Wait) <> Task_OK
  42.      THEN Writeln('Beep: Receive-Status not O.K.')
  43.      ELSE Writeln('Beep: Message received correctly!');
  44.  
  45.   TaskMsgOut('Beep: End of the performance...');
  46.   Terminate;
  47. END;  {Beep}
  48.  
  49. {-----------------------------------------------------------------------------}
  50.  
  51. PROCEDURE SubTask;
  52.  
  53. { Second Sub-Task }
  54.  
  55. VAR Message : String;
  56.  
  57. BEGIN {SubTask}
  58.   TaskMsgOut('SubTask: Ready! - Sleeping for 5 seconds!');
  59.   Sleep(Seconds(5));
  60.  
  61.   TaskMsgOut('SubTask: Receive with wait...');
  62.   IF Receive(BeepNo,@Message,Wait) <> Task_OK
  63.      THEN TaskMsgOut('SubTask: Error during Receive!!')
  64.      ELSE TaskMsgOut('SubTask: Received: '+Message);
  65.  
  66.   TaskMsgOut('SubTask: Get the message from MasterTask, if available');
  67.   IF Receive(AnyTask,@Message,NoWait) <> Task_OK
  68.      THEN TaskMsgOut('SubTask: Error during Receive!!')
  69.      ELSE TaskMsgOut('SubTask: Received: '+Message);
  70.  
  71.   Writeln('SubTask: Message received from Task No. ',ReceivedFrom);
  72.   TaskMsgOut('SubTask: Terminating...');
  73.   Terminate;
  74. END;  {SubTask}
  75.  
  76. {-----------------------------------------------------------------------------}
  77.  
  78. BEGIN {Main}
  79.   ClrScr;
  80.   MessageBuffer := 'Message in a bottle...';
  81.  
  82.   Writeln('MasterTask: Starting the BeepTask!');
  83.   BeepNo := CreateTask(@Beep,Pri_User,500);
  84.   IF BeepNo < 0
  85.      THEN Writeln('MasterTask: Error during creation of the BeepTask!');
  86.  
  87.   Writeln('MasterTask: Starting the SubTask!');
  88.   SubNo := CreateTask(@SubTask,Pri_User,1000);
  89.   IF SubNo < 0
  90.      THEN BEGIN
  91.             Writeln('MasterTask: Task-Create failed!!');
  92.             Halt;
  93.           END;
  94.  
  95.   Sleep(Seconds(1));   { Let it speak to us... }
  96.  
  97.   Writeln('MasterTask: Waiting for the message to be received...');
  98.   IF Send(SubNo,@MessageBuffer,Length(MessageBuffer)+1,Wait) <> Task_OK
  99.      THEN Writeln('MasterTask: Receive-status not O.K.')
  100.      ELSE Writeln('MasterTask: Message received correctly!');
  101.  
  102.   Writeln('MasterTask: Sleeping for 2 seconds...');
  103.   Sleep(Seconds(2));
  104.  
  105.   Writeln('MasterTask: <RETURN> ends!');
  106.   Readln;
  107.   NoSound;
  108. END. {Main}